compare

load packages

library(tidyverse)
library(knitr)

define variables

# paths
outputDir = '/Volumes/psych-cog/dsnlab/auto-motion-output/'

# variables
study = "FP"

load data

# global intensity file created using calculate_global_intensities.R
trash = read.csv(paste0(outputDir,study,'_autoTrash.csv'))

# manually coded file created using manually_coded.R
manual = read.csv(paste0(outputDir,study,'_manuallyCoded.csv'))

# afni 3dToutCount outlier created using merge_outcount.R
outcount = read.csv(paste0(outputDir,study,'_outcount.csv')) %>%
  filter(poly == "p2") %>%
  mutate(trashOut = ifelse(outliers > .075, 1, 0))

compare to manual data

# filter trash dataframe and join with filteredMotion
joined = trash %>% 
  left_join(., manual, by = c("subjectID","run","volume")) %>%
  left_join(., outcount, by = c("subjectID","run","volume")) %>%
  select(subjectID, run, volume, volMean, volSD, trashDiff, trashOut, trash) %>%
  #select(subjectID, run, volume, volMean, volSD, trashDiff, trash) %>%
  mutate(auto = ifelse(trashDiff == 1 & trash == 1, 2, 
                                ifelse(trashDiff == 1 & trash == 0, 3, trash)),
         outcount = ifelse(trashOut == 1 & trash == 1, 2,
                         ifelse(trashOut == 1 & trash == 0, 3, trash)))
joined.plot = joined %>%
  gather(compare, code, -c(subjectID, run, volume, volMean, volSD, trashDiff, trashOut, trash))
  #gather(compare, code, -c(subjectID, run, volume, volMean, volSD, trashDiff, trash))

# check false negatives
falseNeg.auto = joined %>% filter(trashDiff == 0 & trash == 1)
falseNeg.outcount = joined %>% filter(trashOut == 0 & trash == 1)

# check false positives
falsePos.auto = joined %>% filter(trashDiff == 1 & trash == 0)
falsePos.outcount = joined %>% filter(trashOut == 1 & trash == 0)

# check hits
hits.auto = joined %>% filter(trashDiff == 1 & trash == 1)
hits.outcount = joined %>% filter(trashOut == 1 & trash == 1)

summarize results

print group-level results

table = data.frame(falseNeg = c(length(falseNeg.auto$trash),length(falseNeg.outcount$trash)),
           falsePos = c(length(falsePos.auto$trash),length(falsePos.outcount$trash)),
           hits = c(length(hits.auto$trash),length(hits.outcount$trash)))
row.names(table)=c("auto","outcount")
kable(table,format = "pandoc")

	falseNeg	falsePos	hits
auto	186	129	328
outcount	313	104	203

# table = data.frame(falseNeg = c(length(falseNeg.auto$trash)), 
#            falsePos = c(length(falsePos.auto$trash)), 
#            hits = c(length(hits.auto$trash)))
# row.names(table)=c("auto")
# kable(table,format = "pandoc")

summarize by participants

nVol = joined %>% group_by(subjectID) %>% summarize(nVol = length(volume))
summaryPos = falsePos.auto %>% group_by(subjectID) %>% summarize(falsePos = sum(trashDiff, na.rm=T))
summaryNeg = falseNeg.auto %>% group_by(subjectID) %>% summarize(falseNeg = sum(trash, na.rm=T))
summaryPosNeg = nVol %>%
  full_join(., summaryPos, by = "subjectID") %>% 
  full_join(., summaryNeg, by = "subjectID") %>% 
  mutate(falseNeg = ifelse(is.na(falseNeg), 0, falseNeg),
         falsePos = ifelse(is.na(falsePos), 0, falsePos),
         totalErrors = falsePos + falseNeg,
         percentErrors = (totalErrors/nVol)*100)

print subject-level results

joined %>% group_by(subjectID) %>% 
  summarise(trashManual = sum(trash, na.rm = T), 
            trashAuto = sum(trashDiff, na.rm = T)) %>%
  full_join(., summaryPosNeg, by = "subjectID") %>%
  select(-nVol) %>%
  arrange(trashManual) %>%
  kable(format = "pandoc", digits = 1)

subjectID	trashManual	trashAuto	falsePos	falseNeg	totalErrors	percentErrors
FP010	0	0	0	0	0	0.0
FP016	0	0	0	0	0	0.0
FP019	0	0	0	0	0	0.0
FP022	0	0	0	0	0	0.0
FP025	0	0	0	0	0	0.0
FP028	0	0	0	0	0	0.0
FP029	0	0	0	0	0	0.0
FP021	1	0	0	1	1	0.1
FP007	3	7	4	0	4	0.6
FP008	3	0	0	3	3	0.4
FP009	3	0	0	3	3	0.4
FP014	3	0	0	3	3	0.4
FP024	3	4	3	2	5	0.7
FP020	4	9	7	2	9	1.3
FP031	4	3	3	4	7	1.0
FP002	6	6	3	3	6	0.9
FP013	6	0	0	6	6	0.9
FP026	6	7	1	0	1	0.1
FP035	6	4	2	4	6	0.9
FP004	7	5	3	5	8	1.1
FP027	7	4	1	3	4	0.6
FP015	10	14	6	2	8	1.1
FP030	12	7	0	5	5	1.0
FP005	14	17	8	5	13	1.9
FP006	14	12	6	8	14	2.0
FP032	14	7	3	10	13	1.9
FP023	17	8	5	14	19	2.7
FP001	24	32	10	2	12	1.7
FP018	37	32	12	17	29	4.2
FP012	40	28	5	17	22	3.2
FP003	55	46	7	16	23	3.3
FP011	74	59	16	31	47	6.8
FP034	143	146	24	20	44	6.3

# visualize for each subject subject
joined.plot = joined.plot %>% mutate(code = as.factor(code)) %>%
  select(subjectID, run, volume, volMean, volSD, compare, code) %>%
  gather(measure, value, -c(subjectID, run, compare, volume, code))

nada = joined.plot %>% group_by(subjectID) %>%
  do({
    plot = ggplot(., aes(volume, value)) + 
      geom_point(aes(color = code)) + 
      geom_line() + 
      facet_grid(measure + compare ~ run, scales= "free") +
      scale_colour_discrete(drop = FALSE, labels=c("not trash", "false neg", "hit", "false pos")) + 
      labs(title = .$subjectID[[1]])
    print(plot)
    #ggsave(plot, file=paste0(outputDir,'plots/',.$subjectID[[1]],'.png'), width = 12)
    data.frame()
  })